home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 038a / huffman.zip / HUFFMAN.BAS
BASIC Source File  |  1990-07-14  |  4KB  |  128 lines
  1. CLS
  2. InFile$="A SIMPLE STRING TO BE ENCODED USING A MINIMAL NUMBER OF BITS"
  3. CALL Huffman(InFile$,OutFile$,NewFile$)
  4. print:print:print
  5. PRINT "In:  ";LEN(InFile$);InFile$
  6. PRINT "Out: ";LEN(OutFile$)
  7. PRINT "New: ";LEN(NewFile$);NewFile$
  8. input,r
  9. END
  10. '*****************************************************************************
  11. '   Huffman Encoding File Compression Technique
  12. '
  13. '   From: R Sedgwick.  Algorithms.  Reading, MA: Addison-Wesley.
  14. '                      1984.  Second Ed.  pp  286 / 93.
  15. '
  16. '   Converted to Power Basic by M. Rosenberg CI$: [73707,2545]
  17. '
  18. SUB Huffman(InText$,OutText$,NewText$)
  19.     SHARED N%,Heap%(),Count%()
  20.     DIM Count%(1024),Heap%(1024),Dad%(1024),Code%(256),Leng%(256)
  21.  
  22. ' Count the frequency of each character in the message to be encoded (P. 287)
  23.  
  24.     FOR I%=0 to 255 : Count%(I%)=0 : NEXT I%
  25.     Csr%=0 :  DO : INCR Csr% : X%=ASC(MID$(InText$,Csr%,1)) : INCR Count%(X%)
  26.             LOOP UNTIL Csr%=LEN(InText$)
  27.  
  28. ' Initialize the heap array to point to non-zero frequency counts (P. 290)
  29.  
  30.     N%=0 : FOR I%=0 to 255 : IF Count%(I%)<>0 THEN INCR N% : Heap%(N%)=I%
  31.           NEXT I%
  32. ' Construct an indirect heap on the frequency values (P. 289)
  33.  
  34.     FOR K% = N% TO 1 STEP -1 : CALL PqDownHeap(K%) : NEXT K%
  35.  
  36. ' Construct the trie (P. 290)
  37.     DO : T%=Heap%(1) : Heap%(1)=Heap%(N%) : DECR N%
  38.         CALL PqDownHeap(1)
  39.         Count%(255+N%)=Count%(Heap%(1))+Count%(T%)
  40.         Dad%(T%)=255+N% : Dad%(Heap%(1))=-255-N%
  41.         Heap%(1)=255+N% : CALL PqDownHeap(1)
  42.     LOOP UNTIL N%=1
  43.     Dad%(255+N%)=0
  44.  
  45. ' Reconstruct the information from the representation of the coding tree (P.291)
  46. '    computed during the sifting process.
  47.  
  48.     FOR K% = 0 TO 255
  49.         IF Count%(K%)=0 THEN
  50.             Code%(K%)=0 : Leng%(K%)=0
  51.         ELSE
  52.             I%=0 : J&=1 : T%=Dad%(K%) : X%=0
  53.             DO : IF T%<0 THEN X%=X%+J& : T%=0-T%
  54.                 T%=Dad%(T%) : J&=J&+J& : INCR I%
  55.             LOOP UNTIL T%=0
  56.             Code%(K%)=X% : Leng%(K%)=I%
  57.         END IF
  58.     NEXT K%
  59.  
  60. ' Use the computed representations of the code to encode the string (P. 292)
  61.  
  62.     J%=0 : OutText$="" : Hold$=""
  63.     DO : INCR J%
  64.         Char%=ASC(MID$(InText$,J%,1)) : Compr$=BIN$(Code%(Char%))
  65.         DO WHILE LEN(Compr$)< Leng%(Char%) : Compr$="0"+Compr$ : LOOP
  66.         Hold$=Hold$+Compr$
  67.         IF LEN(Hold$)>8 THEN
  68.             OutText$=OutText$+CHR$(Bin2Int(LEFT$(Hold$,8)))
  69.             Hold$=RIGHT$(Hold$,LEN(Hold$)-8)
  70.         END IF
  71.     LOOP UNTIL J%=LEN(InText$)
  72.  
  73. ' Add a byte at the end that contains any left-over bits
  74.  
  75.     IF LEN(Hold$)>0 THEN
  76.         Hold$=Hold$+STRING$(8-LEN(Hold$),"0")
  77.         OutText$=OutText$+CHR$(Bin2Int(LEFT$(Hold$,8)))
  78.     END IF
  79. '*****************************************************************************
  80. ' Unpack compressed string into character representation of binary
  81.  
  82.     J%=0 : UnCompr$="" : NewText$=""
  83.     DO : INCR J%
  84.         Hold$=MID$(OutText$,J%,1) : Hold$=BIN$(ASC(Hold$))
  85.         DO WHILE LEN(Hold$)<8 : Hold$="0"+Hold$ : LOOP
  86.         UnCompr$=UnCompr$+Hold$
  87.     LOOP UNTIL J%=LEN(OutText$)
  88.  
  89. ' Decode compressed string
  90.  
  91.     DO : FOR  K%=1 TO 256
  92.             IF K%=256 THEN EXIT LOOP         'All done
  93.             IF  Leng%(K%)>0 THEN
  94.                 IF Bin2Int(LEFT$(UnCompr$,Leng%(K%)))=Code%(K%) THEN
  95.                     UnCompr$=RIGHT$(UnCompr$,LEN(UnCompr$)-Leng%(K%))
  96.                     NewText$=NewText$+CHR$(K%) : EXIT FOR
  97.                 END IF
  98.             END IF
  99.         NEXT K%
  100.     LOOP UNTIL LEN(UnCompr$) = 0
  101.  
  102.  
  103. END SUB 'Huffman
  104.  
  105. SUB PqDownHeap(K%)
  106. ' Build and maintain an indirect heap on the frequency values (P. 139)
  107. '     reversing the inequalities since we want the smallest values first.
  108.  
  109.     SHARED N%,Heap%(),Count%()
  110.     LOCAL J%,V%,Limit%
  111.     V%=Heap%(K%) : Limit% = N%/2
  112.     DO WHILE K% <= Limit%
  113.        J%=K%+K%
  114.        IF J%<N% THEN IF Count%(Heap%(J%)) > Count%(Heap%(J%+1)) THEN INCR J%
  115.        IF Count%(V%)<=Count%(Heap%(J%)) THEN Heap%(K%)=V% : EXIT SUB
  116.        Heap%(K%)=Heap%(J%) : Heap%(J%)=V% : K%=J%
  117.     LOOP
  118. END SUB 'PqDownHeap
  119.  
  120. '*****************************************************************************
  121. FUNCTION Bin2Int(X$)
  122.     X$=RTRIM$(X$) :X$=LTRIM$(X$) : Ll%=LEN(X$) : Ex%=0 : Tot%=0 : I%=Ll%
  123.     DO WHILE I% > 0
  124.         IF MID$(X$,I%,1)="1" THEN Tot&=Tot&+(2^Ex&)
  125.         INCR Ex& : DECR I% : WEND
  126.     Bin2Int=Tot&
  127. END FUNCTION 'Bin2Int
  128.